home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / tbbs / evnts102.zip / EVENTS.PRG < prev    next >
Text File  |  1996-04-19  |  44KB  |  1,676 lines
  1. *****************************
  2. * Events!
  3. *
  4. * A free calendar program to display upcoming events.
  5. *
  6. *
  7. * 2-7-96 TF  Added feature to put a * on days that have events
  8. *            scheduled in month view.
  9. *
  10. *            Fixed a few minor glitches with the Today and Jump
  11. *            functions.
  12. *
  13. *            Added the Next and Previous month functions to the help
  14. *            screen and reformated help screen a bit.
  15. *
  16. *            Changed version number to 1.01 to reflect changes.
  17. *
  18. * 2-19-96 TF Fixed the JUMP command so that it is aware of different
  19. *            centuries.
  20. *
  21. *            Made a few other cosmetic changes changing things like the
  22. *            color of the "Press any key..." prompt.
  23. *
  24. * 2-21-96 TF Added an entry parameter to allow the sysop to set the minimum
  25. *            user level required to Add or Edit events in the database. Only
  26. *            user with a priviledge level greater than or equal to the edLevel
  27. *            may Add new events. The only user that created the event may edit
  28. *            or delete it. Those with priv level > 200 can edit or delete
  29. *            any events. To use this parameter put a slash (/) followed by
  30. *            the privilege level after the title of the calendar.
  31. *            The Add, Edit and Delete commands will only be shown to users with
  32. *            the proper privilege level.
  33. *
  34. *            If logged in with priv >= 200 you can now see the user ID
  35. *            of the user who created an event when viewing the events.
  36. *            Regular users do not see this info.
  37. *
  38. *            If logged in with priv >= 200 you have access to the "Janitor"
  39. *            commands. Currently, the only available command allows you to
  40. *            "Cleanup" or pack the database file. The Janitor commands will
  41. *            only be shown to users with privilege level 200 and above.
  42. *
  43. *            Added code to update the events database file if it was created
  44. *            by an older version of this program. Requires that the file
  45. *            DBUPDATE.TPG be in the same directory as the Events! program.
  46. *
  47. *            If the last day of the month had an event scheduled it wasn't
  48. *            being reflected in with an asterisk in the month view. This
  49. *            has been fixed.
  50. *
  51. * 3-26-96 TF Integrated the historic events database back into the Events
  52. *            program. This is stored in the file HISTDB.DBF. All events in
  53. *            the database have the year set to 1900.
  54. *
  55. * 4-10-96 TF Added ability to delete events from a range of dates.
  56. *
  57. *            Changed the version number in the Help box to 1.02 to
  58. *            reflect the changes that have been made.
  59. *
  60.  
  61. set escape off
  62. set deleted on
  63. set century on
  64.  
  65. * First let's check the EVENTDB.DBF file to see if it needs updating
  66. if file("eventdb.dbf")
  67.     use "eventdb.dbf"
  68.     if fcount() < 12
  69.         ? "The EVENTDB.DBF file needs to be updated to work with this version"
  70.         ? "of Events! The old databse file will be renamed EVENTDB.OLD and"
  71.         ? "events from the old database will be copied to the new file."
  72.         ? "When the conversion is done you will be returned back to the BBS."
  73.         ? "The next time you access this menu item the Events! program will"
  74.         ? "work normally."
  75.         ?
  76.         ? "Would you like to do the update now? (Y/N)"
  77.  
  78.         key = upper(chr(inkey(0)))
  79.         if key = "Y"
  80.             dotbbs type 200 optdata homepath() + "dbupdate /q"
  81.         else
  82.             quit
  83.         endif
  84.     endif
  85. endif
  86.  
  87. Public eDate, uQuit, lDate, drwScreen, calFile, eNum, rdb
  88. Public calTitle, eText, monthView
  89.  
  90. * set procedure to evprocs
  91.  
  92. * Put the cursor in the top left of the screen
  93. @0,0 say ""
  94.  
  95. * Global Stuff
  96. ON = .T.
  97. OFF = .F.
  98. uQuit = .F.
  99.  
  100. * Name of the default event database files
  101. calFile     =   "EVENTDB.DBF"
  102. histFile    =   "HISTDB.DBF"
  103.  
  104. eNum = 1
  105. maxLines = 18
  106.  
  107. eDate = date()
  108. eYear = year(eDate)
  109. eMonth = month(eDate)
  110. eDay = day(eDate)
  111.  
  112. edLevel = 200
  113. adminLevel = 200
  114.  
  115. *
  116. * Read the OPTDATA and pull out the title info if available
  117. * otherwise we just use the default title
  118. *
  119. offset = at(chr(38)+chr(38), optdata())
  120. if offset <> 0
  121.     if "/" $ substr(optdata(), offset)
  122.         flag = at("/", substr(optdata(), offset))
  123.         calTitle = trim(substr(optdata(), offset + 3, (offset + flag) - (offset + 3) - 1))
  124.         tmp = trim(substr(optdata(), offset + flag))
  125.         if .not. isalpha(tmp)
  126.             edLevel = val(tmp)
  127.         endif
  128.     else
  129.         calTitle = trim(substr(optdata(), offset + 3))
  130.     endif
  131. else
  132.     calTitle = "Events!"
  133. endif
  134.  
  135.  
  136. * If the event database file doesn't exist then create it
  137. if .not. file(calFile)
  138.     do CreateDB
  139. endif
  140.  
  141. do MonthView with calTitle
  142.  
  143. * Make sure we clean up our mess before leaving
  144. use
  145. close all
  146. erase &rdb
  147. erase &newstruc
  148. quit
  149.  
  150. ******************************
  151. * Month View
  152. Procedure MonthView
  153. Parameters cTitle
  154.  
  155. do CalScreen
  156. drwScreen = .T.
  157.  
  158. do while .T.
  159.     monthView = .T.
  160.  
  161.     if drwScreen
  162.         set color to R/W
  163.         do Center with 1, cTitle
  164.         set color to B/W
  165.         do CalNum with eDate
  166.         do HiLite with eDate, ON
  167.         drwScreen = .F.
  168.    endif
  169.  
  170.     key = inkey(0)
  171.     if key < 0
  172.         key = 0
  173.     endif
  174.  
  175.     sel = upper(chr(key))
  176.  
  177.     do case
  178.  
  179.     *
  180.     * Previous Month
  181.     *
  182.     case sel = "P"
  183.         eMonth = eMonth - 1
  184.         if eMonth < 1
  185.             eMonth = 12
  186.             eYear = eYear - 1
  187.         endif
  188.         eDate = ctod(str(eMonth)+"/"+str(eDay)+"/"+str(eYear))
  189.         do CalScreen
  190.         drwScreen = .T.
  191.  
  192.     *
  193.     * Next Month
  194.     *
  195.     case sel = "N"
  196.         eMonth = eMonth + 1
  197.         if eMonth > 12
  198.             eMonth = 1
  199.             eYear = eYear + 1
  200.         endif
  201.         eDate = ctod(str(eMonth)+"/"+str(eDay)+"/"+str(eYear))
  202.         do CalScreen
  203.         drwScreen = .T.
  204.  
  205.     *
  206.     * Right cursor
  207.     *
  208.     case sel = chr(4)
  209.     do HiLite with eDate, OFF
  210.     eDate = eDate + 1
  211.     do HiLite with eDate, ON
  212.     if eMonth <> month(eDate)
  213.         eMonth = month(eDate)
  214.         drwScreen = .T.
  215.     endif
  216.  
  217.     *
  218.     * Left Cursor
  219.     *
  220.     case sel = chr(19)
  221.     do HiLite with eDate, OFF
  222.     eDate = eDate - 1
  223.     do HiLite with eDate, ON
  224.     if eMonth <> month(eDate)
  225.         eMonth = month(eDate)
  226.         drwScreen = .T.
  227.     endif
  228.  
  229.     *
  230.     * Cursor Up
  231.     *
  232.     case sel = chr(5)
  233.     do HiLite with eDate, OFF
  234.     eDate = eDate - 7
  235.     do HiLite with eDate, ON
  236.     if eMonth <> month(eDate)
  237.         eMonth = month(eDate)
  238.         drwScreen = .T.
  239.     endif
  240.  
  241.     *
  242.     * Cursor Down
  243.     *
  244.     case sel = chr(24)
  245.     do HiLite with eDate, OFF
  246.     eDate = eDate + 7
  247.     do HiLite with eDate, ON
  248.     if eMonth <> month(eDate)
  249.         eMonth = month(eDate)
  250.         drwScreen = .T.
  251.     endif
  252.  
  253.     *
  254.     * Quit - on Q or ESC
  255.     *
  256.     case sel = "Q" .or. key = 27
  257.         uQuit = .F.
  258.         set color to W/
  259.         @5,0 clear to 24,79
  260.         do UserQuit
  261.         if uQuit
  262.             return
  263.         else
  264.             do CalScreen
  265.             drwScreen = .T.
  266.         endif
  267.  
  268.     *
  269.     * Help
  270.     *
  271.     case sel = "?"
  272.         do ShowHelp
  273.         do CalScreen
  274.         drwScreen = .T.
  275.  
  276.     *
  277.     * Info
  278.     *
  279.     case sel = "I"
  280.         do ShowInfo
  281.         do CalScreen
  282.         drwScreen = .T.
  283.  
  284.     *
  285.     * Select
  286.     *
  287.     case sel = chr(13)
  288.         do WeekView with cTitle
  289.         drwScreen = .T.
  290.     *
  291.     * Show History
  292.     *
  293.     case sel = "H"
  294.         set color to R/W
  295.         do WeekHdr with "On This day in History", eDate
  296.         set color to B/W
  297.         do DayLite with eDate, .T.
  298.         do HistView with eDate
  299.         do calScreen
  300.         drwScreen = .T.
  301.  
  302.     *
  303.     * Jump to Date
  304.     *
  305.     case sel = "J"
  306.         do GetDate
  307.         do CalScreen
  308.         eMonth = month(eDate)
  309.         drwScreen = .T.
  310.  
  311.     *
  312.     * Today - Jump to today's date
  313.     *
  314.     case sel = "T"
  315.         eDate = date()
  316.         do CalScreen
  317.         eMonth = month(eDate)
  318.         drwScreen = .T.
  319.  
  320.     *
  321.     * Add Event
  322.     *
  323.     case sel = "A"
  324.         if upriv() >= edLevel
  325.             do DayHeader with "Add Event", eDate
  326.             do AddEvent
  327.             do CalScreen
  328.             drwScreen = .T.
  329.         endif
  330.  
  331.     *
  332.     * Cleanup the Database
  333.     *
  334.     case sel = "C"
  335.         if upriv() > adminLevel
  336.             do DBPack
  337.             do CalScreen
  338.             drwScreen = .T.
  339.         endif
  340.  
  341.     *
  342.     * Remove old events
  343.     *
  344.     case sel = "R"
  345.         if upriv() > adminLevel
  346.             do RemEvents
  347.             do CalScreen
  348.             drwScreen = .T.
  349.         endif
  350.  
  351.  
  352.     endcase
  353.  
  354. enddo
  355. return
  356.  
  357. ******************************
  358. * Week View
  359. Procedure WeekView
  360. Parameters cTitle
  361.  
  362. monthView = .F.
  363.  
  364. eNum = 0
  365. drwScreen = .T.
  366. do while .T.
  367.  
  368.     if drwScreen
  369.         set color to R/W
  370.         do WeekHdr with cTitle, eDate
  371.         set color to B/W
  372.         do DayLite with eDate, .T.
  373.         do ReadDayDB with eDate
  374.         do EventLite with eNum, ON
  375.         drwScreen = .F.
  376.     endif
  377.  
  378.     key = inkey(0)
  379.     if key < 0
  380.         key = 0
  381.     endif
  382.  
  383.     sel = upper(chr(key))
  384.  
  385.     do case
  386.  
  387.     *
  388.     * Right cursor - Move to next day
  389.     *
  390.     case sel = chr(4)
  391.         do DayLite with eDate, .F.
  392.         eDate = eDate + 1
  393.         eNum = 0
  394.         do DayLite with  eDate, .T.
  395.         do ReadDayDB with eDate
  396.         do EventLite with eNum, ON
  397.  
  398.     *
  399.     * Left Cursor - Move to previous day
  400.     *
  401.     case sel = chr(19)
  402.         do DayLite with eDate, .F.
  403.         eDate = eDate - 1
  404.         eNum = 0
  405.         do DayLite with  eDate, .T.
  406.         do ReadDayDB with eDate
  407.  
  408.     *
  409.     * Previous Month
  410.     *
  411.     case sel = "P"
  412.         eMonth = eMonth - 1
  413.         if eMonth < 1
  414.             eMonth = 12
  415.             eYear = eYear - 1
  416.         endif
  417.         eDate = ctod(str(eMonth)+"/"+str(eDay)+"/"+str(eYear))
  418.         drwScreen = .T.
  419.  
  420.     *
  421.     * Next Month
  422.     *
  423.     case sel = "N"
  424.         eMonth = eMonth + 1
  425.         if eMonth > 12
  426.             eMonth = 1
  427.             eYear = eYear + 1
  428.         endif
  429.         eDate = ctod(str(eMonth)+"/"+str(eDay)+"/"+str(eYear))
  430.         drwScreen = .T.
  431.  
  432.  
  433.     *
  434.     * Cursor Up - Move to previous item in list of events
  435.     *
  436.     case sel = chr(5)
  437.         if eNum > 1
  438.             do EventLite with eNum, OFF
  439.             eNum = eNum - 1
  440.             do EventLite with eNum, ON
  441.         endif
  442.  
  443.     *
  444.     * Cursor Down - Move to next item in list of events
  445.     *
  446.     case sel = chr(24)
  447.         if eNum > 0 .and. eNum <> reccount()
  448.             do EventLite with eNum, OFF
  449.             eNum = eNum +1
  450.             do EventLite with eNum, ON
  451.         endif
  452.  
  453.     *
  454.     * Quit
  455.     *
  456.     case sel = "Q" 
  457.         uQuit = .F.
  458.         set color to w/
  459.         @7,0 clear to 24,79
  460.         do UserQuit
  461.         if uQuit
  462.             return to master
  463.         else
  464.             drwScreen = .T.
  465.         endif
  466.  
  467.     *
  468.     * Help
  469.     *
  470.     case sel = "?"
  471.         do ShowHelp
  472.         drwScreen = .T.
  473.  
  474.     *
  475.     * Info
  476.     *
  477.     case sel = "I"
  478.         do ShowInfo
  479.         drwScreen = .T.
  480.  
  481.     *
  482.     * Select
  483.     *
  484.     case sel = chr(13)
  485.         if eNum > 0
  486.             do EventView with eDate, eNum
  487.             drwScreen = .T.
  488.         endif
  489.  
  490.     *
  491.     * History
  492.     *
  493.     case sel = "H"
  494.         do HistView with eDate
  495.         drwScreen = .T.
  496.  
  497.     *
  498.     * Jump to Date
  499.     *
  500.     case sel = "J"
  501.         do GetDate
  502.         drwScreen = .T.
  503.  
  504.     *
  505.     * Today - Jump to today's date
  506.     *
  507.     case sel = "T"
  508.         eDate = date()
  509.         drwScreen = .T.
  510.  
  511.     *
  512.     * Add an Event
  513.     *
  514.     case sel = "A"
  515.         if upriv() >= edLevel
  516.             do DayHeader with "Add Event", eDate
  517.             do AddEvent
  518.             eNum = 0
  519.             drwScreen = .T.
  520.         endif
  521.  
  522.     *
  523.     * Edit an Event
  524.     *
  525.     case sel = "E"
  526.         if  eNum > 0 .and. upriv() >= edLevel
  527.             cNum = RNUM
  528.             use &calFile
  529.             go cNum
  530.             if upriv() >= adminLevel .or. (uname() = rtrim(EVUSER) .and. upriv() >= edLevel)
  531.                 do DayHeader with "Edit Event", eDate
  532.                 do EditEvent with cNum
  533.                 eNum = 0
  534.                 drwScreen = .T.
  535.             else
  536.                 do NotAuth
  537.                 drwScreen = .T.
  538.             endif
  539.         endif
  540.  
  541.     *
  542.     * Delete an Event
  543.     *
  544.     case sel = "D"
  545.         if  eNum > 0 .and. upriv() >= edLevel
  546.             cNum = RNUM
  547.             use &calFile
  548.             go cNum
  549.             if upriv() > adminLevel .or. (uname() = rtrim(EVUSER) .and. upriv() >= edLevel)
  550.                 curRec = cNum
  551.                 do Box3D with 8,12,13,68,0
  552.                 set color to R/W
  553.                 do Center with 9,"Delete Event"
  554.                 set color to B/W
  555.                 do center with 11,"Are you sure you want to delete this event? (Y/N)"
  556.                 wait "" to key
  557.                 if upper(key) = "Y"
  558.                     use &calFile
  559.                     go curRec
  560.                     delete
  561.                     use
  562.                 endif
  563.                 set color to w/
  564.                 eNum = 0
  565.                 drwScreen = .T.
  566.             else
  567.                 do NotAuth
  568.                 drwScreen = .T.
  569.             endif
  570.         endif
  571.  
  572.     *
  573.     * Change to Month View on ESC
  574.     *
  575.     case key = 27
  576.         do CalScreen
  577.         drwScreen = .T.
  578.         return
  579.  
  580.     *
  581.     * Cleanup the Database
  582.     *
  583.     case sel = "C"
  584.         if upriv() > adminLevel
  585.             do DBPack
  586.             drwScreen = .T.
  587.         endif
  588.  
  589.     *
  590.     * Remove old events
  591.     *
  592.     case sel = "R"
  593.         if upriv() > adminLevel
  594.             do RemEvents
  595.             drwScreen = .T.
  596.         endif
  597.  
  598.     endcase
  599. enddo
  600. return
  601.  
  602.  
  603. **************************************************************
  604. * Events! Procedures
  605.  
  606. ********************************
  607. Procedure HiLite
  608. Parameters cDate, cState
  609. *
  610. * Change the highlight the given date.
  611. *
  612. Private cRow, cCol, cDay1
  613.  
  614. cCol = 6 + ((dow(cDate) - 1) * 10)
  615. cDay1 = cDate - (day(cDate) - 1)
  616. cRow = 6 + (int(((day(cDate)-1)+ (dow(cDay1)-1))/7) * 3)
  617.  
  618. if cState
  619.     set color to BG+/B
  620. else
  621.     set color to B/W
  622. endif
  623.  
  624. @cRow,cCol-1 say " " + ltrim(str(day(cDate))) + " "
  625.  
  626. return
  627.  
  628. ********************************
  629. Procedure DayLite
  630. Parameters cDate, cState
  631. *
  632. * Change the highlight on the day in the WeekView.
  633. *
  634. Private cRow, cCol, dCols
  635.  
  636. cRow = 4
  637. dCols = " 8162433445462"
  638. cCol = val(substr(dCols,((dow(cDate)-1)*2+1),2))
  639.  
  640. if cState
  641.     set color to B/W
  642.     @2,20 clear to 2,60
  643.     do LongDate with cDate
  644.     @2,6 say lDate
  645.     set color to BG+/B
  646. else
  647.     set color to B/W
  648. endif
  649.  
  650. @cRow,cCol say cdow(cDate)
  651.  
  652. return
  653.  
  654. ********************************
  655. Procedure EventLite
  656. Parameters cNum, cState
  657. *
  658. * Change the highlight on the event in the event list.
  659. *
  660.  
  661. if cNum <> 0
  662.     go cNum
  663.  
  664.     if cState
  665.         set color to N/W
  666.     else
  667.         set color to W+/
  668.     endif
  669.  
  670.     @cNum + 6, 5 say rtrim(RTITLE)
  671. endif
  672. return
  673.  
  674. ********************************
  675. Procedure ReadDayDB
  676. Parameters cDate
  677. *
  678. * Checks for and displays list of events scheduled of the given date.
  679. *
  680. Private theRec, theTitle, theRow, theNum
  681.  
  682. * Make temporary databases with filename based on user's line number.
  683. * This database is used to hold the record numbers and titles of the
  684. * events found in the main event database file.
  685.  
  686. * First we close all the databases that might be open
  687. use
  688.  
  689. * Then we create our new list file
  690. rdb = "rdb"+ULINE()+".DBF"
  691. newlist = "elist"+ULINE()+".DBF"
  692.  
  693. if file(rdb)
  694.     erase &rdb
  695. endif
  696.  
  697. create &newlist
  698. use &newlist
  699. append blank
  700. replace field_name with "RNUM", field_type with "N", field_len with 6
  701. append blank
  702. replace field_name with "RTITLE", field_type with "C", field_len with 64
  703.  
  704. * Now create the database from the template
  705. use
  706. create &rdb from &newlist
  707. erase &newlist
  708.  
  709. * Open the 2 databases in different work areas
  710. select 1
  711. use &rdb
  712. select 2
  713.  
  714. * if the database file doesn't exist then create it
  715. if .not. file(calFile)
  716.     do CreateDB
  717. endif
  718.  
  719. use &calFile
  720.  
  721. * Now let's read some records from our database
  722. set color to w/
  723. @7,0 clear
  724. @7,0 say ""
  725.  
  726. if eNum = 0
  727.     eNum = 1
  728. endif
  729.  
  730. set filter to EVDATE = cDate
  731. go top
  732. if eof()
  733.     set color to W+/N
  734.     do Center with 8, "** No events currently scheduled for this date **"
  735.     eNum = 0
  736.     set color to W/
  737. else
  738.     theRow = 6
  739.     do while .not. eof() .and. theRow < 25
  740.         theRow = theRow + 1
  741.         theRec = recno()
  742.         theTitle = EVTITLE
  743.         theUser = EVUSER
  744.         select 1
  745.         append blank
  746.         replace RNUM with theRec
  747.         replace RTITLE with theTitle
  748.  
  749.         * Display the list item
  750.         set color to GR+/N
  751.         @theRow,2 say ltrim(str(recno())) + "."
  752.         set color to W+/N
  753.         @theRow,5 say theTitle
  754.  
  755.         select 2
  756.         skip
  757.     enddo
  758. endif
  759.  
  760. * Clean up our mess
  761. set filter to
  762. use
  763. select 1
  764. use
  765.  
  766. use &rdb
  767. do EventLite with eNum, ON
  768. set color to W/
  769. return
  770.  
  771. ********************************
  772. Procedure HistView
  773. Parameters cDate
  774. *
  775. * Displays list of historical events for the given date.
  776. *
  777. Private theRec, theTitle, theRow, theNum
  778.  
  779. if file(histFile)
  780.     use &histFile
  781. else
  782.     set color to W+/N
  783.     do Center with 8, "** Sorry, the Historic Events database seems to be missing. **"
  784.     set color to R/N
  785.     do Center with 22," *                              * "
  786.     set color to BG+/N
  787.     do Center with 22,"Press any key to continue..."
  788.     set color to W/
  789.     wait ""
  790.     return
  791. endif
  792.  
  793. * Now let's read some records from our database
  794. set color to w/
  795. @7,0 clear
  796. @7,0 say ""
  797.  
  798. if eNum = 0
  799.     eNum = 1
  800. endif
  801.  
  802. * All the events in the HISTDB.DBF file have the year set to 1900
  803. * so we must set the search year to 1900 in order to find the items we want.
  804. set filter to CALDATE = ctod(stuff(dtoc(cDate),7,4,"1900"))
  805.  
  806. go top
  807. if eof()
  808.     set color to W+/N
  809.     do Center with 8, "** Nothing seems to have happened on this date in history **"
  810.     eNum = 0
  811.     set color to W/
  812. else
  813.     theRow = 6
  814.     do while .not. eof() .and. theRow < 21
  815.         theRow = theRow + 1
  816.         theRec = recno()
  817.         theTitle = CALTEXT
  818.  
  819.         * Display the list item
  820.         set color to W+/N
  821.         @theRow,0 say theTitle
  822.  
  823.         skip
  824.     enddo
  825. endif
  826.  
  827. * Clean up our mess
  828. set filter to
  829. use
  830. set color to R/N
  831. do Center with 22," *                              * "
  832. set color to BG+/N
  833. do Center with 22,"Press any key to continue..."
  834. set color to W/
  835. wait ""
  836.  
  837. set century on
  838. set color to W/
  839. return
  840.  
  841. ********************************
  842. Procedure CalNum
  843. Parameters cDate
  844. *
  845. * Draws the month and year in the title area
  846. * and fills the numbers in the calendar
  847. *
  848. Private tDate, tDay, cRow, cCol, cSqr, cnt
  849.  
  850. tDate = cDate
  851. use &calFile
  852.  
  853. tDay = day(tDate)
  854. tDate = tDate - (tDay - 1)
  855. cMonYr = cmonth(tDate) + str(year(tDate))
  856.  
  857. set color to B/W
  858.  
  859. @2,6 clear to 2,70
  860. do Center with 2, cMonYr
  861.  
  862. * Clear the calendar
  863. cRow = 6
  864. cSqr = 0
  865. cnt = 1
  866. do while cnt < 38
  867.     cCol = 6 + cSqr
  868.     @cRow,cCol say "      "
  869.     if cCol = 66
  870.         cRow = cRow + 3
  871.     endif
  872.     cSqr = cSqr + 10
  873.     if cSqr > 60
  874.         cSqr = 0
  875.     endif
  876.     cnt = cnt + 1
  877. enddo
  878.  
  879. * Now fill it in with the proper month
  880. cRow = 6
  881. do while .not. islastday(tDate)
  882.  
  883.     cCol = 6 + ((dow(tDate) - 1) * 10)
  884.  
  885.     * See if we have any events on this day. if so
  886.     * put a "*" in that date
  887.     set filter to EVDATE = tDate
  888.     go top
  889.     if eof()
  890.         @cRow,cCol say ltrim(str(day(tDate)))+ "     "
  891.     else
  892.         @cRow,cCol say ltrim(str(day(tDate)))
  893.         set color to R/W
  894.         @cRow,cCol+3 say "  *"
  895.         set color to B/W
  896.     endif
  897.  
  898.     if cCol = 66
  899.         cRow = cRow + 3
  900.     endif
  901.     tDate = tDate + 1
  902. enddo
  903. * Last but not least we take care of the last day of the month
  904. cCol = 6 + ((dow(tDate) - 1) * 10)
  905. set filter to EVDATE = tDate
  906. go top
  907. if eof()
  908.     @cRow,cCol say ltrim(str(day(tDate)))+ "     "
  909. else
  910.     @cRow,cCol say ltrim(str(day(tDate)))
  911.     set color to R/W
  912.     @cRow,cCol+3 say "  *"
  913.     set color to B/W
  914. endif
  915.  
  916. return
  917.  
  918. ********************************
  919. Procedure EventView
  920. Parameters cDate, cNum
  921. *
  922. * View the database item selected
  923. *
  924. Private recNum
  925.  
  926. use &rdb
  927. go cNum
  928. recNum = RNUM
  929.  
  930. use &calFile
  931. go recNum
  932.  
  933. do DayHeader with "", cDate
  934. set color to B/W
  935. do Center with 4, rtrim(EVTITLE)
  936.  
  937. set color to GR+/N
  938. @7,6 say "Date:"
  939. @9,2 say "Location:"
  940. @12,5 say "Desc.:"
  941. @19,3 say  "Contact:"
  942.  
  943. set color to W+/
  944. @7,12 say dtoc(EVDATE)
  945. @9,12 say EVLOC1
  946. @10,12 say EVLOC2
  947. @12,12 say EVDESC1
  948. @13,12 say EVDESC2
  949. @14,12 say EVDESC3
  950. @15,12 say EVDESC4
  951. @16,12 say EVDESC5
  952. @17,12 say EVDESC6
  953. @19,12 say EVCONT
  954.  
  955. * Only show who created the event to the administrators
  956. if upriv() > adminLevel
  957.     set color to B/W
  958.     @20,0 say space(79)
  959.     @20,2 say "Login ID:"
  960.     set color to R/W
  961.     @20,12 say EVUSER
  962. endif
  963.  
  964. set color to R/N
  965. do Center with 21," *                              * "
  966. set color to BG+/N
  967. do Center with 21,"Press any key to continue..."
  968. set color to W/
  969. wait ""
  970.  
  971. use
  972. return
  973.  
  974. ********************************
  975. Procedure DayHeader
  976. Parameters dhTitle, cDate
  977. * Put a box at the top of the screen with the current day and a title
  978. * Used in the EventView and Edit modes
  979.  
  980. do LongDate with cDate
  981. set color to w/
  982. @0,0 clear
  983.  
  984. do Box3D with 0,1,6,79,0
  985.  
  986. set color to R/W
  987. do Center with 1, dhTitle
  988. set color to B/W
  989. do Center with 2, lDate
  990. set color to R/W
  991. do Center with 3, replicate("─", 72)
  992. set color to W/N
  993. @8,0 clear to 24,79
  994. return
  995.  
  996. ********************************
  997. Procedure WeekHdr
  998. Parameters whTitle, cDate
  999. *
  1000. set color to w/
  1001. @0,0 clear
  1002. do LongDate with cDate
  1003. do Box3D with 0,1,6,79,0
  1004.  
  1005. set color to R/W
  1006. do Center with 1, whTitle
  1007. set color to B/W
  1008. @2,6 say lDate
  1009. @2,66 say "<?> Help"
  1010. set color to R/W
  1011. do Center with 3, replicate("─", 72)
  1012. set color to W/N
  1013. @9,0 clear to 24,79
  1014. set color to B/W
  1015. @4,8 say "Sunday  Monday  Tuesday  Wednesday  Thursday  Friday  Saturday"
  1016. return
  1017.  
  1018. **********************************
  1019. Procedure LongDate
  1020. Parameters cDate
  1021. * Put the date in long form into the public string lDate
  1022.  
  1023. Private tDay, pday, post
  1024.  
  1025. pday = day(cDate)
  1026.  
  1027. * Put the postfix on the date
  1028. do case
  1029.     case pday = 1 .or. pday = 21 .or. pday = 31
  1030.         post = "st"
  1031.     case pday = 2 .or. pday = 22
  1032.         post = "nd"
  1033.     case pday = 3 .or. pday = 23
  1034.         post = "rd"
  1035.     otherwise
  1036.         post = "th"
  1037. endcase
  1038.  
  1039. lDate = cdow(cDate) + ", " + ltrim(cMonth(cDate)) + " " + ltrim(str(day(cDate))) + post + ", " + ltrim(str(year(cDate)))
  1040. return
  1041.  
  1042. ********************************
  1043. Procedure GetDate
  1044. *
  1045. * Get a date from the user
  1046. *
  1047.  
  1048. do Box3D with 9,20,12,60,0
  1049. set color to B/W
  1050. @10,22 say "Jump to date: "
  1051. @10,40 get eDate picture "@D"
  1052. read
  1053. return
  1054.  
  1055. ********************************
  1056. Procedure RemEvents
  1057. *
  1058. * Remove events from the database between the selected
  1059. * range of dates.
  1060. *
  1061. Private startDate, endDate
  1062.  
  1063. do Box3D with 7,10,17,70,0
  1064. startDate = date() - 30
  1065. endDate = date()
  1066. set intensity on
  1067. set color to R/W,w+/n
  1068. do Center with 8, "Remove Old Events"
  1069. set color to B/W,w+/n
  1070. @15,54 say "<ESC> Cancel"
  1071. set color to R/W,w+/n
  1072. @15,55 say "ESC"
  1073. set color to B/W,w+/n
  1074. @10,14 say "Start Date:" get startDate picture "@D"
  1075. @12,14 say "  End Date:" get endDate picture "@D"
  1076. read
  1077. key = readkey()
  1078.  
  1079. do case
  1080.     * Check for ESC key
  1081.     case key = 12 .or. key = 268
  1082.         return
  1083.  
  1084.     * Check for valid date range
  1085.     case startDate > endDate
  1086.         @15,12 clear to 15,66
  1087.         do center with 14,"Invalid date range!"
  1088.         do center with 15," * Press any key to continue *"
  1089.         wait ""
  1090.  
  1091.     otherwise
  1092.         @14,14 say "Really remove events between these dates? (Y/N)"
  1093.         key = inkey(0)
  1094.         if  chr(key) = "Y" .or. chr(key) = "y"
  1095.             * Delete events within the selected range of dates
  1096.             @14,12 clear to 15,66
  1097.             do center with 14, "Deleting events. Please wait..."
  1098.             use &calFile
  1099.             set filter to
  1100.             go top
  1101.             do while .not. EOF()
  1102.                 if EVDATE >= startDate .and. EVDATE <= endDate
  1103.                     delete
  1104.                 endif
  1105.                 skip
  1106.             enddo
  1107.         endif
  1108.     endcase
  1109.     use
  1110. return
  1111.  
  1112.  
  1113. ****************************
  1114. Procedure ShowHelp
  1115.  
  1116. set color to W/N
  1117. if monthView
  1118.     @5,0 clear to 24,79
  1119. else
  1120.     @7,0 clear to 24,79
  1121. endif
  1122.  
  1123. do Box3D with 7,8,21,72,0
  1124. set color to R/W
  1125. do Center with 8, "Events!  v1.02"
  1126. set color to B/W
  1127. do Center with 9, "By Tony Fardella"
  1128. @11,12 say "Cursor Keys - Move   Enter  - Select  ESC - Back/Quit"
  1129. @12,12 say "J - Jump to Date     T - Today        Q - Quit"
  1130. @13,12 say "N - Next Month       P - Prev Month   H - History"
  1131. @14,12 say "I - Information"
  1132. * Only show these commands to users with the proper privilege level.
  1133. if upriv() >= edLevel
  1134.     @15,12 say "A - Add Event        E - Edit Event   D - Delete Event"
  1135. endif
  1136.  
  1137. * Only show these commands to users with privilege level >= adminLevel
  1138. if upriv() >= adminLevel
  1139.     set color to GR+/W
  1140.     do center with 16,"Janitor's Closet"
  1141.     set color to W+/W
  1142.     @17,12 say "C - Clean Database   R - Remove Events"
  1143. endif
  1144.  
  1145. set color to R/W
  1146. do Center with 19, "Press any key to continue"
  1147.  
  1148. wait ""
  1149. set color to w/
  1150. return
  1151.  
  1152. ****************************
  1153. Procedure ShowInfo
  1154.  
  1155. set color to W/N
  1156. if monthView
  1157.     @5,0 clear to 24,79
  1158. else
  1159.     @7,0 clear to 24,79
  1160. endif
  1161.  
  1162. * do Box3D with 7,2,21,78,0
  1163. set color to BG+/N
  1164. do Center with 7, "Events!  v1.02"
  1165. do Center with 9, "by Tony Fardella (tonyf@crl.com)"
  1166. set color to R/N
  1167. do Center with 8,  "──────────────────────────────────────────────────────────────────"
  1168. set color to W/N
  1169. do Center with 11, "Events! allows you to post information on events or activities for others to"
  1170. do Center with 12, "to view.  An event may be listed for any day of the year. Each listing"
  1171. do Center with 13, "includes a title, date, location, a description and contact information for"
  1172. do Center with 14, "the event.  Days with scheduled events will have an asterisk (*) next to them"
  1173. do Center with 15, "in the monthly calendar view.  You may add, edit, and delete events in the"
  1174. do Center with 16, "Events! database.  You can jump to any date by pressing [J] and return to the"
  1175. do Center with 17, "current date by pressing [T]. A listing of historical events for any date may"
  1176. do Center with 18, "be accessed by pressing [H]."
  1177. do Center with 20, "* Have Fun! *"
  1178.  
  1179. set color to W+/N
  1180. do Center with 22, "* Press any key to continue *"
  1181.  
  1182. wait ""
  1183. set color to w/
  1184. return
  1185.  
  1186. *********************************
  1187. * Add Event
  1188. *
  1189. Procedure AddEvent
  1190. Private ctitle, cdate, cloc1, cloc2, cdes1, cdes2, cdes3, cdes4, cdes5, cdes6, ccont
  1191.  
  1192. set century on
  1193. clear gets
  1194.  
  1195. ctitle  = space(60)
  1196. cloc1   = space(60)
  1197. cloc2   = space(60)
  1198. cdes1   = space(60)
  1199. cdes2   = space(60)
  1200. cdes3   = space(60)
  1201. cdes4   = space(60)
  1202. cdes5   = space(60)
  1203. cdes6   = space(60)
  1204.  
  1205. ccont   = space(60)
  1206. cdate   = eDate
  1207.  
  1208. @7,0 clear
  1209.  
  1210. * set delimiters to "::"
  1211. set delimiters on
  1212. set intensity on
  1213.  
  1214. do while .T.
  1215.     set color to B/W
  1216.     @4,4 clear to 4,76
  1217.     @4,4 say "[ESC] Menu"
  1218.     set color to R/W
  1219.     @4,5 say "ESC"
  1220.  
  1221.     set color to bg/n,w+/n
  1222.     @7,5 say "Title" get ctitle
  1223.     @9,6 say "Date" get cdate picture "@D"
  1224.     @11,2 say "Location"
  1225.     @11,11 get cloc1
  1226.     @12,11 get cloc2
  1227.     @14,6 say "Info"
  1228.     @14,11 get cdes1
  1229.     @15,11 get cdes2
  1230.     @16,11 get cdes3
  1231.     @17,11 get cdes4
  1232.     @18,11 get cdes5
  1233.     @19,11 get cdes6
  1234.     @21,3 say "Contact" get ccont
  1235.     read
  1236.  
  1237.     set color to R/W
  1238.     @4,4 clear to 4,76
  1239.     do while .T.
  1240.         set color to B/W
  1241.         @4,4 say "[E]dit"
  1242.         @4,12 say "[S]ave"
  1243.         @4,64 say "[ESC] Cancel"
  1244.         set color to R/W
  1245.         @4,5 say "E"
  1246.         @4,13 say "S"
  1247.         @4,65 say "ESC"
  1248.         @4,79 say ""
  1249.  
  1250.         key = inkey(0)
  1251.         if key < 0
  1252.             key = 0
  1253.         endif
  1254.  
  1255.         sel = upper(chr(key))
  1256.         do case
  1257.  
  1258.             case sel = "S"
  1259.             *
  1260.             * if the database file doesn't exist then create it
  1261.             *
  1262.             if .not. file(calFile)
  1263.                 do CreateDB
  1264.             endif
  1265.  
  1266.             *
  1267.             * Write the new event to the database
  1268.             *
  1269.             use &calFile
  1270.             append blank
  1271.             replace EVTITLE with ctitle
  1272.             replace EVDATE with cdate
  1273.             replace EVLOC1 with cloc1
  1274.             replace EVLOC2 with cloc2
  1275.             replace EVDESC1 with cdes1
  1276.             replace EVDESC2 with cdes2
  1277.             replace EVDESC3 with cdes3
  1278.             replace EVDESC4 with cdes4
  1279.             replace EVDESC5 with cdes5
  1280.             replace EVDESC6 with cdes6
  1281.             replace EVCONT with ccont
  1282.             replace EVUSER with uname()
  1283.  
  1284.             use
  1285.             eNum = 0
  1286.             do ReadDayDB with eDate
  1287.             return
  1288.  
  1289.         case sel = chr(27)          && ESC
  1290.             return
  1291.  
  1292.         case sel = "E"              && Edit
  1293.             exit
  1294.  
  1295.         endcase
  1296.     enddo
  1297. enddo
  1298.  
  1299. set color to W/
  1300. return
  1301.  
  1302. *********************************
  1303. * Edit Event
  1304. *
  1305. Procedure EditEvent
  1306. Parameter cNum
  1307. Private ctitle, cdate, cloc1, cloc2, cdes1, cdes2, cdes3, cdes4, cdes5, cdes6, ccont
  1308.  
  1309. clear gets
  1310.  
  1311. use &calFile
  1312. go cNum
  1313.  
  1314. ctitle  = EVTITLE
  1315. cdate   = EVDATE
  1316. cloc1   = EVLOC1
  1317. cloc2   = EVLOC2
  1318. cdes1   = EVDESC1
  1319. cdes2   = EVDESC2
  1320. cdes3   = EVDESC3
  1321. cdes4   = EVDESC4
  1322. cdes5   = EVDESC5
  1323. cdes6   = EVDESC6
  1324. ccont   = EVCONT
  1325.  
  1326. @7,0 clear
  1327.  
  1328. * set delimiters to "::"
  1329. set delimiters on
  1330. set intensity on
  1331.  
  1332. do while .T.
  1333.     set color to B/W
  1334.     @4,4 clear to 4,76
  1335.     @4,4 say "[ESC] Menu"
  1336.     set color to R/W
  1337.     @4,5 say "ESC"
  1338.  
  1339.  
  1340.     set color to bg/n,w+/n
  1341.     @7,5 say "Title" get ctitle
  1342.     @9,6 say "Date" get cdate picture "@D"
  1343.     @11,2 say "Location"
  1344.     @11,11 get cloc1
  1345.     @12,11 get cloc2
  1346.     @14,6 say "Info"
  1347.     @14,11 get cdes1
  1348.     @15,11 get cdes2
  1349.     @16,11 get cdes3
  1350.     @17,11 get cdes4
  1351.     @18,11 get cdes5
  1352.     @19,11 get cdes6
  1353.     @21,3 say "Contact" get ccont
  1354.     read
  1355.  
  1356.     set color to R/W
  1357.     @4,4 clear to 4,76
  1358.     do while .T.
  1359.         set color to B/W
  1360.         @4,4 say "[E]dit"
  1361.         @4,12 say "[S]ave"
  1362.         @4,64 say "[ESC] Cancel"
  1363.         set color to R/W
  1364.         @4,5 say "E"
  1365.         @4,13 say "S"
  1366.         @4,65 say "ESC"
  1367.         @4,79 say ""
  1368.  
  1369.         key = inkey(0)
  1370.         if key < 0
  1371.             key = 0
  1372.         endif
  1373.  
  1374.         sel = upper(chr(key))
  1375.         do case
  1376.  
  1377.             case sel = "S"
  1378.  
  1379.             *
  1380.             * Write the event to the database
  1381.             *
  1382.             replace EVTITLE with ctitle
  1383.             replace EVDATE with cdate
  1384.             replace EVLOC1 with cloc1
  1385.             replace EVLOC2 with cloc2
  1386.             replace EVDESC1 with cdes1
  1387.             replace EVDESC2 with cdes2
  1388.             replace EVDESC3 with cdes3
  1389.             replace EVDESC4 with cdes4
  1390.             replace EVDESC5 with cdes5
  1391.             replace EVDESC6 with cdes6
  1392.             replace EVCONT with ccont
  1393.             replace EVUSER with uname()
  1394.  
  1395.             use
  1396.             eNum = 0
  1397.             do ReadDayDB with eDate
  1398.             return
  1399.  
  1400.         case sel = chr(27)        && ESC
  1401.             return
  1402.  
  1403.         case sel = "E"
  1404.             exit
  1405.  
  1406.         endcase
  1407.     enddo
  1408.  
  1409. enddo
  1410.  
  1411. set color to W/
  1412. return
  1413.  
  1414. ***************************
  1415. Procedure CreateDB
  1416.  
  1417. *
  1418. * if the database file doesn't exist then create it
  1419. *
  1420. if .not. file(calFile)
  1421.     create newstruc
  1422.     use newstruc
  1423.     append blank
  1424.     replace field_name with "EVTITLE", field_type with "C", field_len with 64
  1425.     append blank
  1426.     replace field_name with "EVDATE", field_type with "D", field_len with 8
  1427.     append blank
  1428.     replace field_name with "EVLOC1", field_type with "C", field_len with 64
  1429.     append blank
  1430.     replace field_name with "EVLOC2", field_type with "C", field_len with 64
  1431.     append blank
  1432.     replace field_name with "EVDESC1", field_type with "C", field_len with 64
  1433.     append blank
  1434.     replace field_name with "EVDESC2", field_type with "C", field_len with 64
  1435.     append blank
  1436.     replace field_name with "EVDESC3", field_type with "C", field_len with 64
  1437.     append blank
  1438.     replace field_name with "EVDESC4", field_type with "C", field_len with 64
  1439.     append blank
  1440.     replace field_name with "EVDESC5", field_type with "C", field_len with 64
  1441.     append blank
  1442.     replace field_name with "EVDESC6", field_type with "C", field_len with 64
  1443.     append blank
  1444.     replace field_name with "EVCONT", field_type with "C", field_len with 64
  1445.     append blank
  1446.     replace field_name with "EVUSER", field_type with "C", field_len with 32
  1447.  
  1448.     use
  1449.     create &calFile from newstruc
  1450.     erase newstruc.dbf
  1451. endif
  1452. return
  1453.  
  1454. *******************************
  1455. Procedure NotAuth
  1456. *
  1457. * Bring up a dialog telling the user they can't
  1458. * edit or delete a record they didn't create
  1459. *
  1460. set color to W/N
  1461.  
  1462. do Box3D with 8,12,15,68,0
  1463. set color to R/W
  1464. do center with 9,"Sorry"
  1465. set color to B/W
  1466. do center with 11,"You can't edit or delete an event you didn't create"
  1467. do center with 13, "Press any key to continue"
  1468. wait "" to key
  1469. set color to w/
  1470. return
  1471.  
  1472. *******************************
  1473. Procedure UserQuit
  1474. *
  1475. * Bring up a dialog box asking if the user really wants to quit.
  1476. *
  1477. set color to W/N
  1478.  
  1479. do Box3D with 8,18,13,62,0
  1480. set color to R/W
  1481. do center with 9,"Quit?"
  1482. set color to B/W
  1483. do center with 11,"Are you sure you want to quit? (Y/N)"
  1484. wait "" to key
  1485. if upper(key) = "Y"
  1486.     uQuit = .T.
  1487. endif
  1488. set color to w/
  1489. return
  1490.  
  1491. ********************************
  1492. Procedure Center
  1493. Parameters nRow, cText
  1494. *
  1495. * Centers text string on the screen
  1496. *
  1497. * Input: nRow = screen row
  1498. *        cText = text string
  1499. *
  1500.  
  1501. private nCol
  1502. nCol = Uwidth() - Len(cText)
  1503. nCol = Max(nCol,0)
  1504. nCol = nCol / 2
  1505. If Uansi()
  1506.     @nRow,nCol say cText
  1507. else
  1508.     ? Replicate(" ",nCol) + cText
  1509. endif
  1510. return
  1511.  
  1512. ***************************
  1513. Procedure Box3D
  1514. Parameters orgRow, orgCol,  endRow, endCol, bStyle
  1515.  
  1516. Private nRow
  1517. *
  1518. * Create a "3D" box of the size passed by the input parameters
  1519. *
  1520. * Input: orgRow, orgCol = starting point
  1521. *        endRow, endCol = ending point
  1522. *        bStyle = Box Style 0 = recessed  1 = extruded
  1523.  
  1524. set intensity off
  1525. set color to N/W
  1526. @orgRow,orgCol say " "
  1527. if bStyle = 0
  1528.     set color to  N+/W
  1529. else
  1530.     set color to  W+/W
  1531. endif
  1532. @orgRow,orgCol+1 say "┌" + replicate("─",(endCol - orgCol) - 4)
  1533. if bStyle = 0
  1534.     set color to W+/W
  1535. else
  1536.     set color to  N+/W
  1537. endif
  1538.  
  1539. @orgRow,endCol-2 say "┐ "
  1540. set color to N+/N
  1541. @orgRow,endCol say "▄"
  1542.  
  1543. nRow = orgRow + 1
  1544. do while nRow < endRow - 1
  1545.     set color to N/W
  1546.     @nRow,orgCol say " "
  1547.     if bStyle = 0
  1548.         set color to  N+/W
  1549.     else
  1550.         set color to  W+/W
  1551.     endif
  1552.     @nRow,orgCol+1 clear to nRow,endCol
  1553.     @nRow,orgCol+1 say "│"
  1554.     if bStyle = 0
  1555.         set color to  W+/W
  1556.     else
  1557.         set color to  N+/W
  1558.     endif
  1559.     @nRow,endCol-2 say "│"
  1560.     set color to N+/N
  1561.     @nRow,endCol say "█"
  1562.     nrow = nRow + 1
  1563. enddo
  1564.  
  1565. set color to N/W
  1566. @endRow-1,orgCol say " "
  1567. if bStyle = 0
  1568.     set color to  N+/W
  1569. else
  1570.     set color to  W+/W
  1571. endif
  1572. @endRow-1,orgCol+1 say "└"
  1573. if bStyle = 0
  1574.     set color to  W+/W
  1575. else
  1576.     set color to  N+/W
  1577. endif
  1578. @endRow-1,orgCol+2 say replicate("─",(endCol - orgCol) - 4) + "┘ "
  1579. set color to N+/N
  1580. @endRow-1,endCol say "█"
  1581.  
  1582. set color to N+/N
  1583. @endRow,orgCol say " "  + replicate("▀",endCol - orgCol)
  1584. return
  1585.  
  1586. **************************
  1587. Procedure CalScreen
  1588. *
  1589. * Display Print the calendar template on the screen
  1590. ? chr(27)+"[40m"+chr(27)+"[2J"+chr(27)+"[3C"+chr(27)+"[47m "+chr(27)+"[0;1;30;47m┌────────────────────────────────────────────────────────────────────"+chr(27)+"[37m┐ "+chr(27)+"[30;40m▄"
  1591. ? chr(27)+"[2;1H   "+chr(27)+"[47m │                                                                    "+chr(27)+"[37m│ "+chr(27)+"[30;40m█"
  1592. ? chr(27)+"[3;1H   "+chr(27)+"[47m │                                                                    "+chr(27)+"[37m│ "+chr(27)+"[30;40m█"
  1593. ? chr(27)+"[4;1H   "+chr(27)+"[47m │   "+chr(27)+"[0;31;47mSun       Mon       Tue       Wed       Thu       Fri       Sat  "+chr(27)+"[1;37m│ "+chr(27)+"[30;40m█"
  1594. ? chr(27)+"[5;1H   "+chr(27)+"[47m └"+chr(27)+"[37m────────────────────────────────────────────────────────────────────┘ "+chr(27)+"[30;40m█"
  1595. ? chr(27)+"[6;1H   "+chr(27)+"[47m ┌────────"+chr(27)+"[37m┐"+chr(27)+"[30m┌────────"+chr(27)+"[37m┐"+chr(27)+"[30m┌────────"+chr(27)+"[37m┐"+chr(27)+"[30m┌────────"+chr(27)+"[37m┐"+chr(27)+"[s"
  1596. ? chr(27)+"[u"+chr(27)+"[30m┌────────"+chr(27)+"[37m┐"+chr(27)+"[30m┌────────"+chr(27)+"[37m┐"+chr(27)+"[30m┌────────"+chr(27)+"[37m┐ "+chr(27)+"[30;40m█"
  1597. ? chr(27)+"[7;1H   "+chr(27)+"[47m │        "+chr(27)+"[37m│"+chr(27)+"[30m│        "+chr(27)+"[37m│"+chr(27)+"[30m│        "+chr(27)+"[37m│"+chr(27)+"[30m│        "+chr(27)+"[37m│"+chr(27)+"[s"
  1598. ? chr(27)+"[u"+chr(27)+"[30m│        "+chr(27)+"[37m│"+chr(27)+"[30m│        "+chr(27)+"[37m│"+chr(27)+"[30m│        "+chr(27)+"[37m│ "+chr(27)+"[30;40m█"
  1599. ? chr(27)+"[8;1H   "+chr(27)+"[47m └"+chr(27)+"[37m────────┘"+chr(27)+"[30m└"+chr(27)+"[37m────────┘"+chr(27)+"[30m└"+chr(27)+"[37m────────┘"+chr(27)+"[30m└"+chr(27)+"[37m────────┘"+chr(27)+"[s"
  1600. ? chr(27)+"[u"+chr(27)+"[30m└"+chr(27)+"[37m────────┘"+chr(27)+"[30m└"+chr(27)+"[37m────────┘"+chr(27)+"[30m└"+chr(27)+"[37m────────┘ "+chr(27)+"[30;40m█"
  1601. ? chr(27)+"[9;1H   "+chr(27)+"[47m ┌────────"+chr(27)+"[37m┐"+chr(27)+"[30m┌────────"+chr(27)+"[37m┐"+chr(27)+"[30m┌────────"+chr(27)+"[37m┐"+chr(27)+"[30m┌────────"+chr(27)+"[37m┐"+chr(27)+"[s"
  1602. ? chr(27)+"[u"+chr(27)+"[30m┌────────"+chr(27)+"[37m┐"+chr(27)+"[30m┌────────"+chr(27)+"[37m┐"+chr(27)+"[30m┌────────"+chr(27)+"[37m┐ "+chr(27)+"[30;40m█"
  1603. ? chr(27)+"[10;1H   "+chr(27)+"[47m │        "+chr(27)+"[37m│"+chr(27)+"[30m│        "+chr(27)+"[37m│"+chr(27)+"[30m│        "+chr(27)+"[37m│"+chr(27)+"[30m│        "+chr(27)+"[37m│"+chr(27)+"[s"
  1604. ? chr(27)+"[u"+chr(27)+"[30m│        "+chr(27)+"[37m│"+chr(27)+"[30m│        "+chr(27)+"[37m│"+chr(27)+"[30m│        "+chr(27)+"[37m│ "+chr(27)+"[30;40m█"
  1605. ? chr(27)+"[11;1H   "+chr(27)+"[47m └"+chr(27)+"[37m────────┘"+chr(27)+"[30m└"+chr(27)+"[37m────────┘"+chr(27)+"[30m└"+chr(27)+"[37m────────┘"+chr(27)+"[30m└"+chr(27)+"[37m────────┘"+chr(27)+"[s"
  1606. ? chr(27)+"[u"+chr(27)+"[30m└"+chr(27)+"[37m────────┘"+chr(27)+"[30m└"+chr(27)+"[37m────────┘"+chr(27)+"[30m└"+chr(27)+"[37m────────┘ "+chr(27)+"[30;40m█"
  1607. ? chr(27)+"[12;1H   "+chr(27)+"[47m ┌────────"+chr(27)+"[37m┐"+chr(27)+"[30m┌────────"+chr(27)+"[37m┐"+chr(27)+"[30m┌────────"+chr(27)+"[37m┐"+chr(27)+"[30m┌────────"+chr(27)+"[37m┐"+chr(27)+"[s"
  1608. ? chr(27)+"[u"+chr(27)+"[30m┌────────"+chr(27)+"[37m┐"+chr(27)+"[30m┌────────"+chr(27)+"[37m┐"+chr(27)+"[30m┌────────"+chr(27)+"[37m┐ "+chr(27)+"[30;40m█"
  1609. ? chr(27)+"[13;1H   "+chr(27)+"[47m │        "+chr(27)+"[37m│"+chr(27)+"[30m│        "+chr(27)+"[37m│"+chr(27)+"[30m│        "+chr(27)+"[37m│"+chr(27)+"[30m│        "+chr(27)+"[37m│"+chr(27)+"[s"
  1610. ? chr(27)+"[u"+chr(27)+"[30m│        "+chr(27)+"[37m│"+chr(27)+"[30m│        "+chr(27)+"[37m│"+chr(27)+"[30m│        "+chr(27)+"[37m│ "+chr(27)+"[30;40m█"
  1611. ? chr(27)+"[14;1H   "+chr(27)+"[47m └"+chr(27)+"[37m────────┘"+chr(27)+"[30m└"+chr(27)+"[37m────────┘"+chr(27)+"[30m└"+chr(27)+"[37m────────┘"+chr(27)+"[30m└"+chr(27)+"[37m────────┘"+chr(27)+"[s"
  1612. ? chr(27)+"[u"+chr(27)+"[30m└"+chr(27)+"[37m────────┘"+chr(27)+"[30m└"+chr(27)+"[37m────────┘"+chr(27)+"[30m└"+chr(27)+"[37m────────┘ "+chr(27)+"[30;40m█"
  1613. ? chr(27)+"[15;1H   "+chr(27)+"[47m ┌────────"+chr(27)+"[37m┐"+chr(27)+"[30m┌────────"+chr(27)+"[37m┐"+chr(27)+"[30m┌────────"+chr(27)+"[37m┐"+chr(27)+"[30m┌────────"+chr(27)+"[37m┐"+chr(27)+"[s"
  1614. ? chr(27)+"[u"+chr(27)+"[30m┌────────"+chr(27)+"[37m┐"+chr(27)+"[30m┌────────"+chr(27)+"[37m┐"+chr(27)+"[30m┌────────"+chr(27)+"[37m┐ "+chr(27)+"[30;40m█"
  1615. ? chr(27)+"[16;1H   "+chr(27)+"[47m │        "+chr(27)+"[37m│"+chr(27)+"[30m│        "+chr(27)+"[37m│"+chr(27)+"[30m│        "+chr(27)+"[37m│"+chr(27)+"[30m│        "+chr(27)+"[37m│"+chr(27)+"[s"
  1616. ? chr(27)+"[u"+chr(27)+"[30m│        "+chr(27)+"[37m│"+chr(27)+"[30m│        "+chr(27)+"[37m│"+chr(27)+"[30m│        "+chr(27)+"[37m│ "+chr(27)+"[30;40m█"
  1617. ? chr(27)+"[17;1H   "+chr(27)+"[47m └"+chr(27)+"[37m────────┘"+chr(27)+"[30m└"+chr(27)+"[37m────────┘"+chr(27)+"[30m└"+chr(27)+"[37m────────┘"+chr(27)+"[30m└"+chr(27)+"[37m────────┘"+chr(27)+"[s"
  1618. ? chr(27)+"[u"+chr(27)+"[30m└"+chr(27)+"[37m────────┘"+chr(27)+"[30m└"+chr(27)+"[37m────────┘"+chr(27)+"[30m└"+chr(27)+"[37m────────┘ "+chr(27)+"[30;40m█"
  1619. ? chr(27)+"[18;1H   "+chr(27)+"[47m ┌────────"+chr(27)+"[37m┐"+chr(27)+"[30m┌────────"+chr(27)+"[37m┐"+chr(27)+"[30m┌────────"+chr(27)+"[37m┐"+chr(27)+"[30m┌────────"+chr(27)+"[37m┐"+chr(27)+"[s"
  1620. ? chr(27)+"[u"+chr(27)+"[30m┌────────"+chr(27)+"[37m┐"+chr(27)+"[30m┌────────"+chr(27)+"[37m┐"+chr(27)+"[30m┌────────"+chr(27)+"[37m┐ "+chr(27)+"[30;40m█"
  1621. ? chr(27)+"[19;1H   "+chr(27)+"[47m │        "+chr(27)+"[37m│"+chr(27)+"[30m│        "+chr(27)+"[37m│"+chr(27)+"[30m│        "+chr(27)+"[37m│"+chr(27)+"[30m│        "+chr(27)+"[37m│"+chr(27)+"[s"
  1622. ? chr(27)+"[u"+chr(27)+"[30m│        "+chr(27)+"[37m│"+chr(27)+"[30m│        "+chr(27)+"[37m│"+chr(27)+"[30m│        "+chr(27)+"[37m│ "+chr(27)+"[30;40m█"
  1623. ? chr(27)+"[20;1H   "+chr(27)+"[47m └"+chr(27)+"[37m────────┘"+chr(27)+"[30m└"+chr(27)+"[37m────────┘"+chr(27)+"[30m└"+chr(27)+"[37m────────┘"+chr(27)+"[30m└"+chr(27)+"[37m────────┘"+chr(27)+"[s"
  1624. ? chr(27)+"[u"+chr(27)+"[30m└"+chr(27)+"[37m────────┘"+chr(27)+"[30m└"+chr(27)+"[37m────────┘"+chr(27)+"[30m└"+chr(27)+"[37m────────┘ "+chr(27)+"[30;40m█"
  1625. ? chr(27)+"[21;1H   "+chr(27)+"[47m ┌────────"+chr(27)+"[37m┐"+chr(27)+"[30m┌────────"+chr(27)+"[37m┐"+chr(27)+"[30m┌────────────────────────────────────────────────"+chr(27)+"[37m┐ "+chr(27)+"[30;40m█"
  1626. ? chr(27)+"[22;1H   "+chr(27)+"[47m │        "+chr(27)+"[37m│"+chr(27)+"[30m│        "+chr(27)+"[37m│"+chr(27)+"[30m│ "+chr(27)+"[0;31;47mEvents!                       "+chr(27)+"[0;34;47m<Q>uit  <?> Help "+chr(27)+"[1;37m│ "+chr(27)+"[30;40m█"
  1627. ? chr(27)+"[23;1H   "+chr(27)+"[47m └"+chr(27)+"[37m────────┘"+chr(27)+"[30m└"+chr(27)+"[37m────────┘"+chr(27)+"[30m└"+chr(27)+"[37m────────────────────────────────────────────────┘ "+chr(27)+"[30;40m█"
  1628. ? chr(27)+"[24;1H    ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀"+chr(27)+"[0m"+chr(27)+"[255D"
  1629. return
  1630.  
  1631.  
  1632. ************************************
  1633. * Cleanup the database file
  1634. *
  1635. * This procedure removes all the deleted records from
  1636. * the database file. The most of this code is taken from an eSoft
  1637. * TDBS tech note.
  1638. *
  1639. Procedure DBPack
  1640.  
  1641. set color to W/N
  1642.  
  1643. do Box3D with 8,12,13,68,0
  1644. set color to R/W
  1645. do center with 9,"Cleanup Events Database"
  1646. set color to B/W
  1647. do center with 11,"Are you sure you want to clean the database? (Y/N)"
  1648. wait "" to key
  1649. if upper(key) = "Y"
  1650.     ON ERROR DO FILEPROB
  1651.     USE &calFile EXCLUSIVE
  1652.     ON ERROR
  1653.     COPY TO TEMP FOR .NOT. DELETED()
  1654.     ZAP
  1655.     APPEND FROM TEMP
  1656.     ERASE TEMP.DBF
  1657. endif
  1658. set color to w/
  1659. return
  1660.  
  1661. ********************************************
  1662. * Error handler in case USE EXCLUSIVE fails
  1663. *
  1664. PROCEDURE FILEPROB
  1665.  
  1666. set color to W/N
  1667.  
  1668. do Box3D with 8,12,13,68,0
  1669. set color to R/W
  1670. do center with 9,"Sorry"
  1671. set color to B/W
  1672. do center with 11,"The database cannot be cleaned at this time."
  1673. wait ""
  1674. return
  1675.  
  1676.